YES 1.93 H-Termination proof of /home/matraf/haskell/eval_FullyBlown_Fast/List.hs
H-Termination of the given Haskell-Program with start terms could successfully be proven:



HASKELL
  ↳ CR

mainModule List
  ((sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a]) :: (a  ->  a  ->  Ordering ->  [a ->  [a])

module List where
  import qualified Maybe
import qualified Prelude

  merge :: (a  ->  a  ->  Ordering ->  [a ->  [a ->  [a]
merge cmp xs [] xs
merge cmp [] ys ys
merge cmp (x : xs) (y : ys
case x `cmp` y of
  GT-> y : merge cmp (x : xs) ys
  _-> x : merge cmp xs (y : ys)

  merge_pairs :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [[a]]
merge_pairs cmp [] []
merge_pairs cmp (xs : []xs : []
merge_pairs cmp (xs : ys : xssmerge cmp xs ys : merge_pairs cmp xss

  mergesort :: (a  ->  a  ->  Ordering ->  [a ->  [a]
mergesort cmp mergesort' cmp . map wrap

  mergesort' :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [a]
mergesort' cmp [] []
mergesort' cmp (xs : []xs
mergesort' cmp xss mergesort' cmp (merge_pairs cmp xss)

  sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a]
sortBy cmp l mergesort cmp l

  wrap :: a  ->  [a]
wrap x x : []


module Maybe where
  import qualified List
import qualified Prelude



Case Reductions:
The following Case expression
case cmp x y of
 GT → y : merge cmp (x : xsys
 _ → x : merge cmp xs (y : ys)

is transformed to
merge0 y cmp x xs ys GT = y : merge cmp (x : xsys
merge0 y cmp x xs ys _ = x : merge cmp xs (y : ys)



↳ HASKELL
  ↳ CR
HASKELL
      ↳ BR

mainModule List
  ((sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a]) :: (a  ->  a  ->  Ordering ->  [a ->  [a])

module List where
  import qualified Maybe
import qualified Prelude

  merge :: (a  ->  a  ->  Ordering ->  [a ->  [a ->  [a]
merge cmp xs [] xs
merge cmp [] ys ys
merge cmp (x : xs) (y : ysmerge0 y cmp x xs ys (x `cmp` y)

  
merge0 y cmp x xs ys GT y : merge cmp (x : xs) ys
merge0 y cmp x xs ys _ x : merge cmp xs (y : ys)

  merge_pairs :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [[a]]
merge_pairs cmp [] []
merge_pairs cmp (xs : []xs : []
merge_pairs cmp (xs : ys : xssmerge cmp xs ys : merge_pairs cmp xss

  mergesort :: (a  ->  a  ->  Ordering ->  [a ->  [a]
mergesort cmp mergesort' cmp . map wrap

  mergesort' :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [a]
mergesort' cmp [] []
mergesort' cmp (xs : []xs
mergesort' cmp xss mergesort' cmp (merge_pairs cmp xss)

  sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a]
sortBy cmp l mergesort cmp l

  wrap :: a  ->  [a]
wrap x x : []


module Maybe where
  import qualified List
import qualified Prelude



Replaced joker patterns by fresh variables and removed binding patterns.

↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
HASKELL
          ↳ COR

mainModule List
  ((sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a]) :: (a  ->  a  ->  Ordering ->  [a ->  [a])

module List where
  import qualified Maybe
import qualified Prelude

  merge :: (a  ->  a  ->  Ordering ->  [a ->  [a ->  [a]
merge cmp xs [] xs
merge cmp [] ys ys
merge cmp (x : xs) (y : ysmerge0 y cmp x xs ys (x `cmp` y)

  
merge0 y cmp x xs ys GT y : merge cmp (x : xs) ys
merge0 y cmp x xs ys vw x : merge cmp xs (y : ys)

  merge_pairs :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [[a]]
merge_pairs cmp [] []
merge_pairs cmp (xs : []xs : []
merge_pairs cmp (xs : ys : xssmerge cmp xs ys : merge_pairs cmp xss

  mergesort :: (a  ->  a  ->  Ordering ->  [a ->  [a]
mergesort cmp mergesort' cmp . map wrap

  mergesort' :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [a]
mergesort' cmp [] []
mergesort' cmp (xs : []xs
mergesort' cmp xss mergesort' cmp (merge_pairs cmp xss)

  sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a]
sortBy cmp l mergesort cmp l

  wrap :: a  ->  [a]
wrap x x : []


module Maybe where
  import qualified List
import qualified Prelude



Cond Reductions:
The following Function with conditions
undefined 
 | False
 = undefined

is transformed to
undefined  = undefined1

undefined0 True = undefined

undefined1  = undefined0 False



↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
HASKELL
              ↳ Narrow

mainModule List
  (sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a])

module List where
  import qualified Maybe
import qualified Prelude

  merge :: (a  ->  a  ->  Ordering ->  [a ->  [a ->  [a]
merge cmp xs [] xs
merge cmp [] ys ys
merge cmp (x : xs) (y : ysmerge0 y cmp x xs ys (x `cmp` y)

  
merge0 y cmp x xs ys GT y : merge cmp (x : xs) ys
merge0 y cmp x xs ys vw x : merge cmp xs (y : ys)

  merge_pairs :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [[a]]
merge_pairs cmp [] []
merge_pairs cmp (xs : []xs : []
merge_pairs cmp (xs : ys : xssmerge cmp xs ys : merge_pairs cmp xss

  mergesort :: (a  ->  a  ->  Ordering ->  [a ->  [a]
mergesort cmp mergesort' cmp . map wrap

  mergesort' :: (a  ->  a  ->  Ordering ->  [[a]]  ->  [a]
mergesort' cmp [] []
mergesort' cmp (xs : []xs
mergesort' cmp xss mergesort' cmp (merge_pairs cmp xss)

  sortBy :: (a  ->  a  ->  Ordering ->  [a ->  [a]
sortBy cmp l mergesort cmp l

  wrap :: a  ->  [a]
wrap x x : []


module Maybe where
  import qualified List
import qualified Prelude



Haskell To QDPs


↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
QDP
                    ↳ QDPSizeChangeProof
                  ↳ QDP
                  ↳ QDP
                  ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_map(:(vz4110, vz4111), ba) → new_map(vz4111, ba)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the subterm criterion [20] together with the size-change analysis [32] we have proven that there are no infinite chains for this DP problem.

From the DPs we obtained the following set of size-change graphs:



↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
QDP
                    ↳ RuleRemovalProof
                  ↳ QDP
                  ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_merge(vz3, :(vz400, vz401), :(vz390, vz391), ba) → new_merge0(vz390, vz3, vz400, vz401, vz391, ba)
new_merge0(vz390, vz3, vz400, vz401, vz391, ba) → new_merge(vz3, :(vz400, vz401), vz391, ba)
new_merge0(vz390, vz3, vz400, vz401, vz391, ba) → new_merge(vz3, vz401, :(vz390, vz391), ba)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the rule removal processor [15] with the following polynomial ordering [25], at least one Dependency Pair or term rewrite system rule of this QDP problem can be strictly oriented.
Strictly oriented dependency pairs:

new_merge(vz3, :(vz400, vz401), :(vz390, vz391), ba) → new_merge0(vz390, vz3, vz400, vz401, vz391, ba)


Used ordering: POLO with Polynomial interpretation [25]:

POL(:(x1, x2)) = 2 + 2·x1 + x2   
POL(new_merge(x1, x2, x3, x4)) = x1 + x2 + x3 + x4   
POL(new_merge0(x1, x2, x3, x4, x5, x6)) = 2 + 2·x1 + x2 + 2·x3 + x4 + x5 + x6   



↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
                  ↳ QDP
                    ↳ RuleRemovalProof
QDP
                        ↳ DependencyGraphProof
                  ↳ QDP
                  ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_merge0(vz390, vz3, vz400, vz401, vz391, ba) → new_merge(vz3, :(vz400, vz401), vz391, ba)
new_merge0(vz390, vz3, vz400, vz401, vz391, ba) → new_merge(vz3, vz401, :(vz390, vz391), ba)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
The approximation of the Dependency Graph [15,17,22] contains 0 SCCs with 2 less nodes.

↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
                  ↳ QDP
QDP
                    ↳ QDPSizeChangeProof
                  ↳ QDP

Q DP problem:
The TRS P consists of the following rules:

new_merge_pairs(vz36, :(vz38110, :(vz381110, vz381111)), ba) → new_merge_pairs(vz36, vz381111, ba)

R is empty.
Q is empty.
We have to consider all minimal (P,Q,R)-chains.
By using the subterm criterion [20] together with the size-change analysis [32] we have proven that there are no infinite chains for this DP problem.

From the DPs we obtained the following set of size-change graphs:



↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
                  ↳ QDP
                  ↳ QDP
QDP
                    ↳ DependencyGraphProof

Q DP problem:
The TRS P consists of the following rules:

new_mergesort'(vz36, vz37, vz41, vz3811, ba) → new_mergesort'0(vz36, new_merge1(vz36, vz37, vz41, ba), new_merge_pairs0(vz36, vz3811, ba), ba)
new_mergesort'0(vz36, vz37, :(vz380, :(vz3810, vz3811)), ba) → new_mergesort'(vz36, vz37, new_merge1(vz36, vz380, vz3810, ba), vz3811, ba)
new_mergesort'0(vz36, vz37, :(vz380, []), ba) → new_mergesort'0(vz36, new_merge1(vz36, vz37, vz380, ba), [], ba)

The TRS R consists of the following rules:

new_merge_pairs0(vz36, :(vz38110, []), ba) → :(vz38110, [])
new_merge_pairs0(vz36, [], ba) → []
new_merge_pairs0(vz36, :(vz38110, :(vz381110, vz381111)), ba) → :(new_merge1(vz36, vz38110, vz381110, ba), new_merge_pairs0(vz36, vz381111, ba))

The set Q consists of the following terms:

new_merge_pairs0(x0, [], x1)
new_merge_pairs0(x0, :(x1, []), x2)
new_merge_pairs0(x0, :(x1, :(x2, x3)), x4)

We have to consider all minimal (P,Q,R)-chains.
The approximation of the Dependency Graph [15,17,22] contains 1 SCC with 1 less node.

↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
                  ↳ QDP
                  ↳ QDP
                  ↳ QDP
                    ↳ DependencyGraphProof
QDP
                        ↳ QDPOrderProof

Q DP problem:
The TRS P consists of the following rules:

new_mergesort'(vz36, vz37, vz41, vz3811, ba) → new_mergesort'0(vz36, new_merge1(vz36, vz37, vz41, ba), new_merge_pairs0(vz36, vz3811, ba), ba)
new_mergesort'0(vz36, vz37, :(vz380, :(vz3810, vz3811)), ba) → new_mergesort'(vz36, vz37, new_merge1(vz36, vz380, vz3810, ba), vz3811, ba)

The TRS R consists of the following rules:

new_merge_pairs0(vz36, :(vz38110, []), ba) → :(vz38110, [])
new_merge_pairs0(vz36, [], ba) → []
new_merge_pairs0(vz36, :(vz38110, :(vz381110, vz381111)), ba) → :(new_merge1(vz36, vz38110, vz381110, ba), new_merge_pairs0(vz36, vz381111, ba))

The set Q consists of the following terms:

new_merge_pairs0(x0, [], x1)
new_merge_pairs0(x0, :(x1, []), x2)
new_merge_pairs0(x0, :(x1, :(x2, x3)), x4)

We have to consider all minimal (P,Q,R)-chains.
We use the reduction pair processor [15].


The following pairs can be oriented strictly and are deleted.


new_mergesort'0(vz36, vz37, :(vz380, :(vz3810, vz3811)), ba) → new_mergesort'(vz36, vz37, new_merge1(vz36, vz380, vz3810, ba), vz3811, ba)
The remaining pairs can at least be oriented weakly.

new_mergesort'(vz36, vz37, vz41, vz3811, ba) → new_mergesort'0(vz36, new_merge1(vz36, vz37, vz41, ba), new_merge_pairs0(vz36, vz3811, ba), ba)
Used ordering: Polynomial interpretation [25]:

POL(:(x1, x2)) = 1 + x2   
POL([]) = 0   
POL(new_merge1(x1, x2, x3, x4)) = 0   
POL(new_merge_pairs0(x1, x2, x3)) = x2   
POL(new_mergesort'(x1, x2, x3, x4, x5)) = x4   
POL(new_mergesort'0(x1, x2, x3, x4)) = x3   

The following usable rules [17] were oriented:

new_merge_pairs0(vz36, :(vz38110, []), ba) → :(vz38110, [])
new_merge_pairs0(vz36, :(vz38110, :(vz381110, vz381111)), ba) → :(new_merge1(vz36, vz38110, vz381110, ba), new_merge_pairs0(vz36, vz381111, ba))
new_merge_pairs0(vz36, [], ba) → []



↳ HASKELL
  ↳ CR
    ↳ HASKELL
      ↳ BR
        ↳ HASKELL
          ↳ COR
            ↳ HASKELL
              ↳ Narrow
                ↳ AND
                  ↳ QDP
                  ↳ QDP
                  ↳ QDP
                  ↳ QDP
                    ↳ DependencyGraphProof
                      ↳ QDP
                        ↳ QDPOrderProof
QDP
                            ↳ DependencyGraphProof

Q DP problem:
The TRS P consists of the following rules:

new_mergesort'(vz36, vz37, vz41, vz3811, ba) → new_mergesort'0(vz36, new_merge1(vz36, vz37, vz41, ba), new_merge_pairs0(vz36, vz3811, ba), ba)

The TRS R consists of the following rules:

new_merge_pairs0(vz36, :(vz38110, []), ba) → :(vz38110, [])
new_merge_pairs0(vz36, [], ba) → []
new_merge_pairs0(vz36, :(vz38110, :(vz381110, vz381111)), ba) → :(new_merge1(vz36, vz38110, vz381110, ba), new_merge_pairs0(vz36, vz381111, ba))

The set Q consists of the following terms:

new_merge_pairs0(x0, [], x1)
new_merge_pairs0(x0, :(x1, []), x2)
new_merge_pairs0(x0, :(x1, :(x2, x3)), x4)

We have to consider all minimal (P,Q,R)-chains.
The approximation of the Dependency Graph [15,17,22] contains 0 SCCs with 1 less node.